Libris Britannia 4/science library(b).zip/science library(b)/INFO/PCCDEMO.ZIP/COMP1.EXE/SB.PAS

Pascal/Delphi Source File | 1993-12-20 | 4KB | 205 lines

{** SB.PAS - By Steven Arnold **}
uses crt;

const
  maxsize = 65000;

var
  CTVDriver : pointer;
  CTVSize : word;


procedure LoadCTV(filename : string);

{ Loads the CT-VOICE driver into memory, pointed to by "CTVDriver" }

var
  f : file;

begin
  assign(f, filename);
  {$i-}
  reset(f, 1);
  {$i+}
  if ioresult <> 0 then
  begin
    writeln('Error loading ', filename);
    halt;
  end;
  CTVSize := filesize(f);
  getmem(CTVDriver, CTVSize);           { Allocate the memory required }
  blockread(f, CTVDriver^, CTVSize);    { Read the driver in to this memory }
  close(f);
end;

Function CTVVersion:Word; assembler;

{ Returns the version number of the loaded CT-Voice Driver }

asm
  mov bx, 0
  call CTVDriver
end;            { Return is via AX }

procedure SetBaseAddr(address : word); assembler;

{ Sets the base address of the sound card }

asm
  mov bx, 1
  mov ax, address
  call CTVDriver
end;

procedure SetInterrupt(int : word); assembler;

{ Sets the interrupt number of the sound card }

asm
  mov bx, 2
  mov ax, int
  call CTVDriver
end;

function InitSB:boolean; assembler;

{ Initialises the sound card }

asm
  mov bx, 3
  call CTVDriver
  cmp ax, 0
  jne @false
  mov ax, word(TRUE)
  jmp @done
@false:
  mov ax, word(FALSE)
@done:
end;            { Return is via AX }

procedure Speaker(state : boolean); assembler;

{Turns on/off speaker ; If "state" is TRUE, the speaker is turned on }

asm
  mov bx, 4
  mov ax, word(state)
  call CTVDriver
end;

procedure PlayVoice(voice : pointer); assembler;

{ Plays the voice, pointed to by "voice" }

asm
  mov bx, 6
  les di, voice
  call CTVDriver
end;

procedure CancelPlay; assembler;

{ Cancels playing of a voice }

asm
  mov bx, 8
  call CTVDriver
end;

procedure DoneSB; assembler;

{ Un-initialises sound card }

asm
  mov bx, 9
  call CTVDriver
end;

procedure StartSB;
var
  version : word;
begin
  LoadCTV('CT-VOICE.DRV');       {Specify the full path to CT-VOICE here
                                  if it is not in the current directory}

  SetBaseAddr($220);        {Change these values to suit your configuration}
  SetInterrupt(7);

  if not InitSB then
  begin
    writeln('Trouble initialising sound card.');
    halt;
  end;

  version := CTVVersion;
  writeln('CT-Voice version ',hi(version), '.', lo(version));
  Speaker(TRUE);
end;

procedure FinishSB;
begin
  Speaker(FALSE);
  DoneSB;
  freemem(CTVDriver, CTVSize);
end;

procedure LoadVoice(fn : string; buf : pointer; bufsize : word);

{ Loads a voice file from disk, into memory pointed to by "buf" }

var
  f : file;
  result : word;

begin
  assign(f, fn);
  {$i-}
  reset(f, 1);
  if ioresult <> 0 then
  begin
    writeln('Error loading voice file');
    halt;
  end;

  seek(f, 26);     {Skip text in VOC-Header}
  if ioresult <> 0 then
  begin
    writeln('Error loading voice file');
    halt;
  end;
  {$i+}

  blockread(f, buf^, bufsize, result);

  close(f);
end;

var
  vocfn : string;
  voice : pointer;
  reply : char;

begin
  StartSB;

  write('Enter filename : ');
  readln(vocfn);
  if pos('.', vocfn)=0 then vocfn := vocfn+'.VOC';

  getmem(voice, maxsize);
  LoadVoice(vocfn, voice, maxsize);

  writeln('Press any key to play "', vocfn, '"  or "Q" to quit');
  writeln;

  reply := readkey;
  while (upcase(reply) <> 'Q') do
  begin
    CancelPlay;
    PlayVoice(voice);
    reply := readkey;
  end;

  freemem(voice, maxsize);
  FinishSB;
end.